home *** CD-ROM | disk | FTP | other *** search
/ Kit PC World De Ampliacion De Windows 95 / Kit PC World de ampliacion de Windows 95.iso / internet / sweeper / samples / olecon~1 / wizards / autocvt.frm next >
Text File  |  1995-11-25  |  9KB  |  276 lines
  1. VERSION 4.00
  2. Begin VB.Form frmTransform 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Generating Automation Server"
  5.    ClientHeight    =   1695
  6.    ClientLeft      =   4110
  7.    ClientTop       =   5550
  8.    ClientWidth     =   6090
  9.    ControlBox      =   0   'False
  10.    Height          =   2100
  11.    Left            =   4050
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   1695
  16.    ScaleWidth      =   6090
  17.    ShowInTaskbar   =   0   'False
  18.    Top             =   5205
  19.    Width           =   6210
  20.    Begin ComctlLib.ProgressBar ProgressBar1 
  21.       Height          =   255
  22.       Left            =   600
  23.       TabIndex        =   1
  24.       Top             =   840
  25.       Width           =   4815
  26.       _Version        =   65536
  27.       _ExtentX        =   8493
  28.       _ExtentY        =   450
  29.       _StockProps     =   192
  30.       Appearance      =   1
  31.    End
  32.    Begin VB.Label lblmessage 
  33.       Alignment       =   2  'Center
  34.       Caption         =   "Label1"
  35.       Height          =   495
  36.       Left            =   600
  37.       TabIndex        =   0
  38.       Top             =   120
  39.       Width           =   4695
  40.    End
  41. End
  42. Attribute VB_Name = "frmTransform"
  43. Attribute VB_Creatable = False
  44. Attribute VB_Exposed = False
  45. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long _
  46. )
  47.  
  48. Dim m_szGuidLibid As String
  49. Dim m_szGuidPrimaryDispatch As String
  50. Dim m_szGuidCoClass As String
  51.  
  52.  
  53.  
  54. Private Sub Form_Load()
  55.  
  56.     Show
  57.  
  58.     On Error GoTo Blech
  59.     
  60.     If Dir(szSourceDir) = "" Then
  61. Blech:
  62.         szSourceDir = InputBox("Unable to find Template files in '" + szFinalDir + "'. Please Enter an alternate location.", "Control Wizard")
  63.     End If
  64.     On Error GoTo 0
  65.  
  66.     lblmessage.Caption = "Creating Directories"
  67.     Refresh
  68.     m_CreateDirs
  69.     ProgressBar1.Value = 25
  70.     lblmessage.Caption = "Generating GUIDs"
  71.     Refresh
  72.     m_MakeGUIDs
  73.     ProgressBar1.Value = 50
  74.     lblmessage.Caption = "Copying over server files"
  75.     Refresh
  76.     m_CopyFiles
  77.     ProgressBar1.Value = 75
  78.     lblmessage.Caption = "Setting up server"
  79.     Refresh
  80.     m_ReplaceNames
  81.     ProgressBar1.Value = 100
  82.     Refresh
  83. End Sub
  84.  
  85. Sub m_MakeGUIDs()
  86.  
  87.     m_szGuidLibid = GenerateUUID
  88.     m_szGuidPrimaryDispatch = GenerateUUID
  89.     m_szGuidCoClass = GenerateUUID
  90.  
  91. End Sub
  92.  
  93. Private Sub m_CreateDirs()
  94.     On Error GoTo die
  95.     MkDir szFinalDir
  96.  
  97.     
  98.     MkDir szFinalDir + "\Release"
  99.     MkDir szFinalDir + "\Debug"
  100.     Exit Sub
  101.     
  102. die:
  103.     MsgBox "Couldn't Create directories"
  104.     End
  105. End Sub
  106.  
  107. Private Sub m_CopyFiles()
  108.  
  109.     Dim s As String
  110.     s = szControlName
  111.     FileCopy szSourceDir + "\AutoDisp.h", szFinalDir + "\Dispids.h"
  112.     FileCopy szSourceDir + "\guids.cpp", szFinalDir + "\Guids.Cpp"
  113.     FileCopy szSourceDir + "\Autoguid.h", szFinalDir + "\Guids.H"
  114.     FileCopy szSourceDir + "\AutoObj.H", szFinalDir + "\LocalObj.H"
  115.     FileCopy szSourceDir + "\MakeAuto", szFinalDir + "\Makefile"
  116.     FileCopy szSourceDir + "\AutoRes.H", szFinalDir + "\Resource.H"
  117.     FileCopy szSourceDir + "\AutoIPSv.Cpp", szFinalDir + "\" + szServerName + ".Cpp"
  118.     FileCopy szSourceDir + "\AutoTmpl.Def", szFinalDir + "\" + szServerName + ".Def"
  119.     FileCopy szSourceDir + "\AutoTmpl.ODL", szFinalDir + "\" + szServerName + ".ODL"
  120.     If g_fSatellite = False Then
  121.         FileCopy szSourceDir + "\AutoTmpl.RC", szFinalDir + "\" + szServerName + ".RC"
  122.     Else
  123.         FileCopy szSourceDir + "\AutoTSat.RC", szFinalDir + "\" + szServerName + ".RC"
  124.     End If
  125.     
  126.     FileCopy szSourceDir + "\AutoTmpl.Cpp", szFinalDir + "\" + s + "Obj.Cpp"
  127.     FileCopy szSourceDir + "\AutoTmpl.H", szFinalDir + "\" + s + "Obj.H"
  128.     FileCopy szSourceDir + "\Debug\Make.Bat", szFinalDir + "\Debug\Make.Bat"
  129.     FileCopy szSourceDir + "\Release\Make.Bat", szFinalDir + "\Release\Make.Bat"
  130.     
  131. End Sub
  132.  
  133. Private Sub m_ReplaceNames()
  134.     
  135.     Dim s As String
  136.     s = szControlName
  137.     ReplaceFile szFinalDir + "\guids.cpp", "<<DEFSERVERNAME>>", szServerName
  138.     
  139.     ReplaceFile szFinalDir + "\localobj.H", "<<DEFOBJECTNAMECAPS>>", UCase(szControlName)
  140.     
  141.     ReplaceFile szFinalDir + "\makefile", "<<DEFSERVERNAME>>", szServerName
  142.     ReplaceFile szFinalDir + "\makefile", "<<DEFOBJECTNAME>>", szControlName
  143.     
  144.     ReplaceFile szFinalDir + "\" + szServerName + ".cpp", "<<DEFOBJECTNAME>>", szControlName
  145.     ReplaceFile szFinalDir + "\" + szServerName + ".cpp", "<<DEFSERVERNAME>>", szServerName
  146.     ReplaceFile szFinalDir + "\" + szServerName + ".cpp", "<<USESSATELLITELOCALIZATION>>", UCase(Str$(g_fSatellite))
  147.     
  148.     ReplaceFile szFinalDir + "\" + szServerName + ".def", "<<DEFSERVERNAME>>", szServerName
  149.  
  150.     ReplaceFile szFinalDir + "\" + szServerName + ".odl", "<<DEFSERVERNAME>>", szServerName
  151.     ReplaceFile szFinalDir + "\" + szServerName + ".odl", "<<DEFOBJECTNAME>>", szControlName
  152.     ReplaceFile szFinalDir + "\" + szServerName + ".odl", "<<GUID_LIBID>>", m_szGuidLibid
  153.     ReplaceFile szFinalDir + "\" + szServerName + ".odl", "<<GUID_PRIMARY>>", m_szGuidPrimaryDispatch
  154.     ReplaceFile szFinalDir + "\" + szServerName + ".odl", "<<GUID_COCLASS>>", m_szGuidCoClass
  155.  
  156.     ReplaceFile szFinalDir + "\" + szServerName + ".rc", "<<DEFSERVERNAME>>", szServerName
  157.  
  158.     ReplaceFile szFinalDir + "\" + s + "Obj.Cpp", "<<DEFOBJECTNAME>>", szControlName
  159.     ReplaceFile szFinalDir + "\" + s + "Obj.Cpp", "<<DEFOBJECTNAMECAPS>>", UCase(szControlName)
  160.     ReplaceFile szFinalDir + "\" + s + "Obj.Cpp", "<<DEFOBJECTTRUNCNAME>>", s
  161.  
  162.     ReplaceFile szFinalDir + "\" + s + "Obj.h", "<<DEFSERVERNAME>>", szServerName
  163.     ReplaceFile szFinalDir + "\" + s + "Obj.h", "<<DEFOBJECTNAME>>", szControlName
  164.     ReplaceFile szFinalDir + "\" + s + "Obj.h", "<<DEFOBJECTNAMECAPS>>", UCase(szControlName)
  165.     ReplaceFile szFinalDir + "\" + s + "Obj.h", "<<DEFOBJECTTRUNCNAME>>", s
  166.  
  167. #If 0 Then
  168.     If g_fSatellite = True Then
  169.  
  170.         ReplaceFile szFinalDir + "\French\Makefile", "<<DEFCONTROLNAME>>", szControlName
  171.         ReplaceFile szFinalDir + "\French\" + s + "Sat.Def", "<<DEFCONTROLNAME>>", szControlName
  172.         ReplaceFile szFinalDir + "\French\" + s + "Sat.Rc", "<<DEFCONTROLNAME>>", szControlName
  173.         ReplaceFile szFinalDir + "\French\" + s + "Sat.Rc", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  174.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<DEFCONTROLNAME>>", szControlName
  175.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_LIBID>>", m_szGuidLibid
  176.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_PRIMARYDISPATCH>>", m_szGuidPrimaryDispatch
  177.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_EVENTINTERFACE>>", m_szGuidEventInterface
  178.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_COCLASS>>", m_szGuidCoClass
  179.     
  180.     End If
  181. #End If
  182.  
  183. End Sub
  184.  
  185.  
  186.  
  187.  
  188. Function ReplaceData(ByVal sData As String, ByVal sInToken As String, ByVal sOutToken As String) As String
  189.     If Len(sData) = 0 Then Exit Function
  190.     Dim iLast As Integer
  191.     Dim sPart As String
  192.     Dim sTemp As String
  193.     
  194.     sTemp = sData
  195.     
  196.     'Now do double quotes
  197.     iLast = InStr(sData, sInToken)
  198.     While iLast
  199.         sPart = sPart & Left$(sData, iLast - 1) & sOutToken
  200.         sData = Right$(sData, Len(sData) - iLast - Len(sInToken) + 1)
  201.         iLast = InStr(sData, sInToken)
  202.     Wend
  203.     sData = sPart & sData
  204.     'Debug.Print sData
  205.     
  206.     ReplaceData = sData
  207. End Function
  208.     
  209. Function ReplaceFile(ByVal sInName As String, ByVal sInToken As String, ByVal sOutToken As String) As Boolean
  210.     Dim iFNum As Integer
  211.     Dim iFOut As Integer
  212.     Dim sHead As String
  213.     Dim sTemp As String
  214.     
  215.     On Error GoTo fncopnerr
  216.     'Open the files
  217.     iFNum = FreeFile
  218.     Open sInName For Input As #iFNum
  219.     
  220.     iFOut = FreeFile
  221.     Open szFinalDir + "\moo.Tmp" For Output As #iFOut
  222.     
  223.     Do Until EOF(iFNum)
  224.         Line Input #iFNum, sTemp
  225.         sTemp = ReplaceData(sTemp, sInToken, sOutToken)
  226.         Print #iFOut, sTemp
  227.     Loop
  228.     Close #iFNum
  229.     Close #iFOut
  230.     
  231.     Kill sInName
  232.     Name szFinalDir + "\moo.tmp" As sInName
  233.     
  234.     
  235.     
  236.     ReplaceFile = True
  237.     Exit Function
  238.     
  239. fncopnerr:
  240.         MsgBox "Reap File Error - " & Error$ & ""
  241.         ' Resume
  242.         ReplaceFile = False
  243.         Exit Function
  244.  
  245. End Function
  246.  
  247.  
  248.  
  249. Function GenerateUUID() As String
  250.  
  251.     Shell "uuidgen -oMaggots.987"
  252.     Call Sleep(2000)
  253.     
  254.     Open "Maggots.987" For Input As 1
  255.     Line Input #1, GenerateUUID
  256.     Close #1
  257.     Kill "maggots.987"
  258.     
  259. End Function
  260.  
  261. Function GetPPGGuidString() As String
  262.  
  263.     Dim s As String
  264.     
  265.     s = "DEFINE_GUID(CLSID_" + szControlName + "GeneralPage, 0x" + Left(m_szGuidPropPage, 8) _
  266.         + ", 0x" + Mid(m_szGuidPropPage, 10, 4) + ", 0x" + Mid(m_szGuidPropPage, 15, 4) _
  267.         + ", 0x" + Mid(m_szGuidPropPage, 20, 2) + ", 0x" + Mid(m_szGuidPropPage, 22, 2) _
  268.         + ", 0x" + Mid(m_szGuidPropPage, 25, 2) + ", 0x" + Mid(m_szGuidPropPage, 27, 2) _
  269.         + ", 0x" + Mid(m_szGuidPropPage, 29, 2) + ", 0x" + Mid(m_szGuidPropPage, 31, 2) _
  270.         + ", 0x" + Mid(m_szGuidPropPage, 33, 2) + ", 0x" + Mid(m_szGuidPropPage, 35, 2) _
  271.         + ");"
  272.  
  273.     GetPPGGuidString = s
  274.  
  275. End Function
  276.